home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / isamexpt / isambrow.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  21KB  |  601 lines
  1. unit Isambrow;
  2. {copyright 1995 by Norbert Stellberg GmbH,
  3.  parts that are signed with a "*" copyright by TURBO POWER
  4.  or Michael Williams CompuServe: 71552,757 }
  5. interface
  6.  
  7. uses
  8.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  9.   Forms, Dialogs, ExtCtrls,
  10.   LowBrows, Fvcbrows, Filer, IsamTabl;
  11.  
  12. type
  13.   Feld_GetProc = Function(Feld: Integer;
  14.                           Table: TIsamTable;
  15.                           var DATA): String;
  16.   {FELD_GETPROC will be created by the expert in
  17.    the browser-unit.
  18.    It will get the data-fields from your record.
  19.    Example:
  20.      Function TestGetFeldProc(Feld: Integer; Table: TIsamTable; var DATA): String; far;
  21.      var S: String;
  22.      begin
  23.        S:= '';
  24.        With TESTRECORD(Data) do begin
  25.        Case Feld of
  26.          1: s:= String_oem2ansi(Table.AnsiConvert,NAME1)+'^';
  27.          2: s:= String_oem2ansi(Table.AnsiConvert,NAME2)+'^';
  28.          3: s:= String_oem2ansi(Table.AnsiConvert,STREET)+'^';
  29.          4: s:= String_oem2ansi(Table.AnsiConvert,ZIP)+'^';
  30.          5: s:= String_oem2ansi(Table.AnsiConvert,CITY)+'^';
  31.          6: s:= DateStr(DATE)+'^';
  32.          7: s:= FormDezStr(AGE,10);
  33.       end;
  34.     end;
  35.     Result:= S;
  36.   end;   }
  37.  
  38.   TIsamBrowser = class(TFvcBrowser)
  39.     {a descendant of the TFVCBROWSER-Object, whose copyright is
  40.      by TURBO POWER INC.
  41.      Vars and Procs, signed by a "*" are copied from the TFVCBROWSER.
  42.      the copyright will still be held by TURBO POWER}
  43.   private
  44.     { Private declarations }
  45.     FHeader         : THeader;      {a normal header for your browser}
  46.     FSpalten        : TStringList;  {a list of TUEBERSCHRIFTOBJECTS .. see ISBRINST.INT}
  47.     FTable          : TIsamTable;   {the isamtable, that will be browsed}
  48.     FKeySection     : integer; { * Which header section are we searching on }
  49.     FSeparatorChar  : char;    { * Default '^'  }
  50.     FJustLeftChar   : char;    { * Default #255 }
  51.     FJustRightChar  : char;    { * Default #255 }
  52.     FJustCenterChar : char;    { * Default #255 }
  53.     FAllowIncss     : boolean; { * }
  54.     FIncSSColor     : TColor;  { * }
  55.     FIncSSTxtColor  : TColor;  { * }
  56.     Procedure SetTable(const Value: TIsamTable);
  57.     Procedure SetSpalten(const Value: TStringList);
  58.   protected
  59.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  60.     procedure KeyPress(var Key: Char); override;
  61.     function  WriteStringOut(var S      : BRLRowEltString;
  62.                                  LineNr : word;
  63.                                  XOfs   : integer): word; override;
  64.     procedure ShowErrorOccured(EClass: Integer); override;
  65.   public
  66.     BaseLKey    : IsamKeyStr; { * }
  67.     BaseHKey    : IsamKeyStr; { * }
  68.     IncSS       : IsamKeyStr;  { * Incremental search string }
  69.     FTextMargin : TRect;      { * }
  70.     Procedure ResizeHeader;  {must be called after you changed the
  71.                               field widths by drag and drop in your
  72.                               browser}
  73.     Function ReadIni: Integer; {will read browser-settings from an ini-file,
  74.                                {must be called after creating the form and
  75.                                 before showing the browser-form.}
  76.     Procedure SetupBrowser(aParent: TForm); {will show the browser-setup-dialog,
  77.                                 see ISBRINST.INT}
  78.     Function GetRow(GetProc: Feld_GetProc; var DATA):String;
  79.                               {called by the browser to show the data fields}
  80.     Function GetLowBrowser: PLowWinBrowser;
  81.   published
  82.     { Published declarations }
  83.     constructor Create(AOwner: TComponent); override;
  84.     destructor Destroy; override;
  85.     property BrowserHeader  : THeader read FHeader write FHeader;
  86.     property Spalten        : TStringList read FSpalten write SetSpalten;
  87.     property Table          : TIsamTable read FTable write SetTable;
  88.     property KeySection     : {*}integer read FKeySection write FKeySection;
  89.     property SeparatorChar  : {*}char read FSeparatorChar write FSeparatorChar;
  90.     property JustLeftChar   : {*}char read FJustLeftChar write FJustLeftChar;
  91.     property JustRightChar  : {*}char read FJustRightChar write FJustRightChar;
  92.     property JustCenterChar : {*}char read FJustCenterChar write FJustCenterChar;
  93.     property AllowIncSS     : {*}boolean read FAllowIncSS write FAllowIncSS;
  94.     property IncSSColor     : {*}TColor read FIncSSColor write FIncSSColor;
  95.     property IncSSTxtColor  : {*}TColor read FIncSSTxtColor write FIncSSTxtColor;
  96.     procedure ClearIncss;     {*}
  97.   end;
  98.  
  99. Function GetAppName: String;  {procedure, to get the name of your application during runtime}
  100.  
  101. implementation
  102.  
  103. Uses UToolDll, IniFiles, IsBrInst;
  104.  
  105. Var AppName: String;
  106.  
  107. Function GetAppName: String;
  108. var G: String;
  109.     xPos: Integer;
  110. begin
  111.   G:= Application.ExeName;
  112.   xPos:= Pos('\',G);
  113.   While xPos > 0 do begin
  114.     Delete(G,1,xPos);
  115.     xPos:= Pos('\',G);
  116.   end;
  117.   xPos:= Pos('.',G);
  118.   if xPos > 0 then G:= Copy(G,1,xPos-1);
  119.   AppName:= G;
  120.   GetAppName:= G;
  121. end;
  122.  
  123. constructor TIsamBrowser.Create(AOwner : TComponent);
  124. begin
  125.   Inherited Create(AOwner);
  126.   IncSS := '';
  127.   SeparatorChar := '^';
  128.   FJustLeftChar := #255;
  129.   FJustCenterChar := #255;
  130.   FJustRightChar := #255;
  131.   BaseLKey := LowKey;
  132.   BaseHKey := HighKey;
  133.   FIncSSColor := clRed;
  134.   FIncssTxtColor := clWhite;
  135.   FSpalten:= TStringList.Create;
  136. end;
  137.  
  138. Function TIsamBrowser.GetLowBrowser: PLowWinBrowser;
  139. begin
  140.   Result:= BrowserPtr;
  141. end;
  142.  
  143. Destructor TIsamBrowser.Destroy;
  144. begin
  145.   FSpalten.Free;
  146.   Inherited Destroy;
  147. end;
  148.  
  149. Function TIsamBrowser.ReadIni: Integer;
  150. var BrwListe,SListe: TStringList;
  151.     BrwIni: TIniFile;
  152.     FNr,K,i,Code,idx,Arr1,Arr2,Feld: Integer;
  153.     SStr,AktDir,LStr,LenStr,FeldName: String;
  154.     x,Len: Longint;
  155. begin
  156.   AktDir:= ExtractFilePath(Application.ExeName);
  157.   K:= 1;
  158.   BrwIni:= TIniFile.Create(AktDir + GetAppName+'.INI');
  159.   BrwListe:= TStringList.Create;
  160.   SListe:= TStringList.Create;
  161.   K:= BrwIni.ReadInteger(Name+'Key','KeyNo',1);
  162.   BrwIni.ReadSection(Name,BrwListe);
  163.   if BrwListe.Count > 0 then begin
  164.     For i:= 0 to BrwListe.Count-1 do begin
  165.       LStr:= BrwIni.ReadString(Name,BrwListe[i],'');
  166.       if Pos(',',LStr) > 0 then begin
  167.         Val(Copy(LStr,1,Pos(',',LStr)-1),Len,Code);
  168.         Delete(LStr,1,Pos(',',LStr));
  169.         Val(LStr,Idx,Code);
  170.       end
  171.       else begin
  172.         Idx:= i+1;
  173.         Val(LStr,Len,Code);
  174.       end;
  175.       SListe.AddObject(BrwListe[i],TUeberschriftObject.Init(BrwListe[i],Idx,Len));
  176.     end;
  177.     Spalten:= SListe;
  178.   end
  179.   else begin
  180.     if Table <> NIL then begin
  181.       if Table.IsamRecord.Count > 0 then begin
  182.         FNr:= 0;
  183.         For i:= 0 to Table.IsamRecord.Count-1 do begin
  184.           SStr:= Table.IsamRecord[i];
  185.           if (Pos('DUMMY',Uppercase(SStr)) = 0) and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  186.             Len:= 0;
  187.             if Pos(':',SStr) > 0 then begin
  188.               GetArray(SStr,Arr1,Arr2);
  189.               For Feld:= Arr1 to Arr2 do begin
  190.                 FeldName:= Copy(SStr,1,Pos(':',SStr)-1);
  191.                 Strip(FeldName);
  192.                 if Arr1 <> Arr2 then FeldName:= FeldName + DezStr(Feld);
  193.                 LenStr:= Uppercase(SStr);
  194.                 Delete(LenStr,1,Pos(':',LenStr));
  195.                 Strip(LenStr);
  196.                 if Pos('ARRAY[',LenStr) > 0 then begin
  197.                   Delete(LenStr,1,Pos('ARRAY[',LenStr));
  198.                   Delete(LenStr,1,Pos(']',LenStr));
  199.                 end;
  200.                 if Pos('STRING',LenStr) > 0 then begin
  201.                   if Pos('[',LenStr) > 0 then begin
  202.                     Delete(LenStr,1,Pos('[',LenStr));
  203.                     LenStr:= Copy(LenStr,1,Pos(']',LenStr)-1);
  204.                     Val(LenStr,Len,Code);
  205.                   end
  206.                   else Len:= 255;
  207.                 end
  208.                 else if Pos('INTEGER',LenStr) > 0 then Len:= 8
  209.                 else if Pos('WORD',LenStr) > 0 then Len:= 8
  210.                 else if Pos('BYTE',LenStr) > 0 then Len:= 4
  211.                 else if Pos('LONGINT',LenStr) > 0 then Len:= 10
  212.                 else if Pos('REAL',LenStr) >